suppressWarnings(library(mvtnorm))
suppressWarnings(library(multcomp))
suppressWarnings(library(R2HTML))

# retrieve args
Args <- commandArgs(TRUE)

#Copy Args
pValues <- Args[4]
test <- Args[5]
sigLevel <- as.numeric(Args[6])

#Seperate out the p-values

tempChanges <-strsplit(pValues, ",")

txtexpectedChanges <- c("")
expectedChanges <- numeric(0)
lessindex<-1
lessindex2<-1

for(i in 1:length(tempChanges[[1]])) 
{ 
	txtexpectedChanges [length(txtexpectedChanges )+1]=(tempChanges[[1]][i]) 
}

for (i in 1:length(tempChanges[[1]])) 
{
	if (txtexpectedChanges[i+1]=="<0.001") 
	{
		txtexpectedChanges[i+1]="0.0009"
		lessindex=2
	}
	if (txtexpectedChanges[i+1]=="<0.0001") 
	{
		txtexpectedChanges[i+1]="0.00009"
		lessindex2=2
	}

}
expectedChanges<-as.numeric(txtexpectedChanges)
expectedChanges<-sort(expectedChanges)

#Re-order txt values
expectedChanges3<-as.numeric(txtexpectedChanges)
expectedChanges2<-na.omit(expectedChanges3)
tempdata<-data.frame(expectedChanges2,tempChanges)
colnames(tempdata)<-c("num","txt")
tempdata2<-tempdata[with(tempdata,order(num)),]
tempdata3<-tempdata2$txt

pvalus<-c(0)

for (i in 1:length(expectedChanges))
{
	pvalus[i]=expectedChanges[i]
}

#Setup the html file and associated css file
htmlFile <- sub(".csv", ".html", Args[3]); #determine the file name of the html file
.HTML.file = htmlFile
cssFile <- "r2html.css"
cssFile <- paste("'",cssFile,"'", sep="") #need to enclose in quotes when path has spaces in it
HTMLCSS(CSSfile = cssFile)

#Output HTML header

HTML.title("<bf>SilveR P-Value Adjustment", HR=1, align="left")
add<-paste(c("The p-values are adjusted using "), test, sep="")
add<-paste(add, "'s multiple comparison test.", sep="")
HTML.title("</bf> ", HR=2, align="left")
HTML.title(add, HR=0, align="left")

#code for test

#All pairwise test options

allPairwiseTestText = test
if (allPairwiseTestText=="Holm")
{
	allPairwiseTest= "holm"
} else if (allPairwiseTestText=="Hochberg")
{
	allPairwiseTest= "hochberg"
} else if (allPairwiseTestText=="Hommel")
{
	allPairwiseTest= "hommel"
} else if (allPairwiseTestText=="Bonferroni")
{
	allPairwiseTest= "bonferroni"
} else if (allPairwiseTestText=="Benjamini-Hochberg")
{
	allPairwiseTest= "BH"
}

#Calculating the adjusted p-values
pvals<-p.adjust(pvalus, method = allPairwiseTest)


#Table for output

table<-matrix(nrow=length(pvals), ncol=2)
#for ( i in 1:length(pvals))
#{
#	table[i,1]<-tempdata3[i]
#	table[i,1]=format(round(pvalus[i], 4), nsmall=4, scientific=FALSE)
#}
for ( i in 1:length(pvals))
{
	table[i,2]=format(round(pvals[i], 4), nsmall=4, scientific=FALSE)
}

#for (i in 1:length(pvals))
#{
#	if (expectedChanges[i]<0.0001) 
#	{
#		table[i,1]<-0.0001
#		table[i,1]<- paste("<",table[i,1])
#	}
#}

for (i in 1:length(pvals))
{
	if (pvals[i]<0.0001) 
	{
		table[i,2]<-"<0.0001"
#		table[i,2]<- paste("<",table[i,2])
	}
}

table2<-data.frame(tempdata3,table)

colnames(table2)<-c("Unadjusted p-value" , " ","Adjusted p-value")

HTMLbr()
HTML.title("<bf>Results", HR=2, align="left")
HTML(table2, classfirstline="second", align="left")

if (lessindex==2 && lessindex2==1)
{
	message<-c("WARNING: You have entered unadjusted p-values of the form <0.001. For the purposes of the numerical calculation this value has been replaced with 0.0009 and hence the adjusted p-values may be unduly conservative.")

HTML.title("</bf> ", HR=2, align="left")
HTML.title(message, HR=0, align="left")

}
if (lessindex2==2 && lessindex==1)
{
	message<-c("WARNING: You have entered unadjusted p-values of the form <0.0001. For the purposes of the numerical calculation this value has been replaced with 0.00009 and hence the adjusted p-values may be unduly conservative.")

HTML.title("</bf> ", HR=2, align="left")
HTML.title(message, HR=0, align="left")
}
if (lessindex==2 && lessindex2==2)
{
	message<-c("WARNING: You have entered unadjusted p-values of the form <0.001 and <0.0001. For the purposes of the numerical calculation these values has been replaced with 0.0009 and 0.00009 and hence the adjusted p-values may be unduly conservative.")
HTML.title("</bf> ", HR=2, align="left")
HTML.title(message, HR=0, align="left")
}




#Conclusions

HTMLbr()
HTML.title("<bf>Conclusions", HR=2, align="left")

add<-paste(c(""))
inte<-1
for(i in 1:(dim(table2)[1]))
{
	if (pvals[i] <= (sigLevel))
	{
		inte<-inte+1
	}
}
inteperm<-inte
index<-1
for(i in 1:(dim(table2)[1]))
{
	if (pvals[i] <= (sigLevel) & inte==2)
	{
		add<-paste(add, "The unadjusted p-value ", sep="")
		add<-paste(add, table2[i,1], sep="")
		add<-paste(add, " is statistically significant at the ", sep="")
		add<-paste(add, 100*(sigLevel), sep="")
		add<-paste(add, "% level following ", sep="")
		add<-paste(add, test, sep="")
		add<-paste(add, "'s test.", sep="")
	} 
}

if (inte>2)
{
	add<-paste(add, "The unadjusted p-values ", sep="")
}

for(i in 1:(dim(table2)[1]))
{
	if (pvals[i] <= (sigLevel) && inte>=3)
	{
		if (index<=inteperm-3)
		{
			add<-paste(add, table2[i,1], sep="")
			add<-paste(add, ", ", sep="")
		} 
		if (index==inteperm-2)
		{
			add<-paste(add, table2[i,1], sep="")
			add<-paste(add, " and ", sep="")
		} 
		if (index==inteperm-1)
		{
			add<-paste(add, table2[i,1], sep="")
			add<-paste(add, " ", sep="")
		}
		index=index+1
	}
}

if (inte>2)
{
	add<-paste(add, "are statistically significant at the  ", sep="")
	add<-paste(add, 100*(sigLevel), sep="")
	add<-paste(add, "% level following ", sep="")
	add<-paste(add, test, sep="")
	add<-paste(add, "'s test.", sep="")	
}

if (inte==1)
{
	if (dim(table2)[1] >1)
	{
		add<-paste(add, " There are no statistically significant p-values, at the ", sep="")
		add<-paste(add, 100*(sigLevel), sep="")
		add<-paste(add, "% level, following ", sep="")
		add<-paste(add, test, sep="")
		add<-paste(add, "'s test.", sep="")			
	} else {
		add<-paste(add, " The p-value is not statistically significant at the ", sep="")
		add<-paste(add, 100*(sigLevel), sep="")
		add<-paste(add, "% level, following ", sep="")
		add<-paste(add, test, sep="")
		add<-paste(add, "'s test.", sep="")			
	}
}

HTML.title("</bf> ", HR=2, align="left")
HTML.title(add, HR=0, align="left")

#References

HTMLbr()
HTML.title("<bf>Statistical references", HR=2, align="left")

if (allPairwiseTest== "BH" )
{
	HTML.title("<bf> ", HR=2, align="left")
	HTML.title("<bf>Benjamini Y and Hochberg Y. (1995). Controlling the false discovery rate: a practical and powerful approach to multiple testing. 	Journal of the Royal Statistical Society Series B, 57, 289-300. ", HR=0, align="left")
}

if (allPairwiseTest== "bonferroni" )
{
	HTML.title("<bf> ", HR=2, align="left")
	HTML.title("<bf>Bonferroni CE (1936). Teoria statistica delle classi e calcolo delle probabilita.  Pubblicazioni del R Istituto Superiore di Scienze 	Economiche e Commerciali di Firenze, 8, 3-62.", HR=0, align="left")
}
 
if (allPairwiseTest== "hochberg" )
{
	HTML.title("<bf> ", HR=2, align="left")
	HTML.title("<bf>Hochberg Y. (1988). A sharper Bonferroni procedure for multiple tests of significance. Biometrika, 75, 800-803.", HR=0, align="left")
}
if (allPairwiseTest== "holm" )
{
	HTML.title("<bf> ", HR=2, align="left")
	HTML.title("<bf>Holm S. (1979). A simple sequentially rejective multiple test procedure. Scandinavian Journal of Statistics, 6, 65-70.", HR=0, 	align="left")
} 

if (allPairwiseTest== "hommel" )
{
	HTML.title("<bf> ", HR=2, align="left")
	HTML.title("<bf>Hommel G. (1988). A stagewise rejective multiple test procedure based on a modified Bonferroni test. Biometrika, 75, 383-386.", HR=0, 	align="left")
}

HTMLbr()
HTML.title("<bf>R references", HR=2, align="left")

HTML.title("<bf> ", HR=2, align="left")
HTML.title("<bf>   
	R Development Core Team (2008). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. ISBN 3-900051-07-0, URL http://www.R-project.org."
	, HR=0, align="left")

HTML.title("<bf> ", HR=2, align="left")
HTML.title("<bf>   
	Alan Genz, Frank Bretz, Torsten Hothorn with contributions by Tetsuhisa Miwa, Xuefei Mi, Friedrich Leisch and Fabian Scheipl (2008). mvtnorm: Multivariate Normal and t Distributions. R package version 0.9-0. 
	", HR=0, align="left")

HTML.title("<bf> ", HR=2, align="left")
HTML.title("<bf>    
	Lecoutre, Eric (2003). The R2HTML Package. R News, Vol 3. N. 3, Vienna, Austria.
	", HR=0, align="left")

HTML.title("<bf> ", HR=2, align="left")
HTML.title("<bf>    
	Torsten Hothorn, Frank Bretz and Peter Westfall with contributions by Richard M. Heiberger (2007). multcomp: Simultaneous Inference for General Linear Hypotheses. R package version 0.991-8.
	", HR=0, align="left")


